perm filename GEN.F4[JC,MUS] blob
sn#080819 filedate 1974-01-09 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00004 ENDMK
Cā;
SUBROUTINE GEN(FUN)
C AFTER 'SYNTH(F1);' TYPE 99= TO USE H,A,P,K: ALL OTHER
C NUMBERS = H,A ONLY. TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
DIMENSION FUN(50)
COMMON FREQ(3,0/50,50),FUNC(50),AMP(50),II(1),IJJ(3000)
3002 TYPE 1002
1002 FORMAT(' 0 TO CLEAR ELSE 1'/)
ACCEPT 201,AB
IF(AB.NE.0.0)GO TO 1001
DO 15 I=1,50
15 FUN(I)=0.0
201 FORMAT(4F)
1001 FAC=360./50.
16 CALL DPYSET(1,IJJ,3000)
CALL ALINE(0,0,200,0)
CALL ALINE(0,100,0,0)
TYPE 445
445 FORMAT(' TYPE H,A,P,K OR 999'/)
ACCEPT 201,H,AMPL,X,CON
IF(H.EQ.999.)GO TO 446
X=X*50./360.
2016 DO 17 J=1,50
XK=SIND(X*FAC)*AMPL+CON
IF(CON.LT.100.0)GO TO 1
FUN(J)=(XK-100.)*FUN(J)
GO TO 2
1 FUN(J)=FUN(J)+XK
2 X=X+H
IY=FUN(J)*100.
IX=J*4
CALL AVECT(IX,IY)
IF(X.LE.50.)GO TO 17
X=X-50.
17 CONTINUE
CALL DPYOUT(1)
GO TO 16
446 CALL DPYSET(1,IJJ,3000)
CALL ALINE(0,0,200,0)
CALL ALINE(0,100,0,0)
2200 X=FUN(1)
DO 19 I=2,50
H=ABS(FUN(I))
19 IF(X.LT.H)X=H
DO 20 I=1,50
FUN(I)=FUN(I)/X
IY=FUN(I)*100.
IX=(I-1)*4
20 CALL AVECT(IX,IY)
CALL DPYOUT(1)
PAUSE
CALL HYDPOG(1)
RETURN
END